home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / borland / tpwn31.zip / OLEDEMO.ZIP / OLEDEMO.PAS next >
Pascal/Delphi Source File  |  1992-04-06  |  34KB  |  1,170 lines
  1.  
  2. {**************************************************}
  3. {                                                  }
  4. {   Turbo Pascal for Windows                       }
  5. {   Object Linking and Embedding demo program      }
  6. {                                                  }
  7. {   Copyright (c) 1992 by Borland International    }
  8. {                                                  }
  9. {**************************************************}
  10.  
  11. program OleDemo;
  12.  
  13. { This program demonstrates how to implement an OLE client application.
  14.   The program uses the new Ole, ShellAPI, and CommDlg units, and requires
  15.   that the OLECLI.DLL, SHELL.DLL, and COMMDLG.DLL libraries are present.
  16.   The program allows you to create embedded and linked objects using the
  17.   Edit|Paste and Edit|Paste link commands. The OLE objects can be moved
  18.   and resized, and they can be activated through double clicks or using
  19.   the Edit|Object menu. Workspaces can be saved and loaded using the
  20.   File menu. }
  21.  
  22. uses Strings, WinTypes, WinProcs, WObjects, Ole, ShellAPI, CommDlg;
  23.  
  24. {$R OLEDEMO}
  25.  
  26. const
  27.  
  28. { Resource IDs }
  29.  
  30.   id_Menu  = 100;
  31.   id_About = 100;
  32.  
  33. { Menu command IDs }
  34.  
  35.   cm_FileNew       = 100;
  36.   cm_FileOpen      = 101;
  37.   cm_FileSave      = 102;
  38.   cm_FileSaveAs    = 103;
  39.   cm_FileExit      = 104;
  40.   cm_EditCut       = 200;
  41.   cm_EditCopy      = 201;
  42.   cm_EditPaste     = 202;
  43.   cm_EditPasteLink = 203;
  44.   cm_EditClear     = 204;
  45.   cm_HelpAbout     = 300;
  46.   cm_VerbMin       = 900;
  47.   cm_VerbMax       = 999;
  48.  
  49. { Menu item positions }
  50.  
  51.   pos_Edit   = 1;  { Position of Edit item on main menu }
  52.   pos_Object = 6;  { Position of Object item on Edit menu }
  53.  
  54. type
  55.  
  56. { Pointer types }
  57.  
  58.   PAppClient    = ^TAppClient;
  59.   PAppStream    = ^TAppStream;
  60.   PObjectWindow = ^TObjectWindow;
  61.   PMainWindow   = ^TMainWindow;
  62.  
  63. { Filename string }
  64.  
  65.   TFilename = array[0..255] of Char;
  66.  
  67. { OLE file header }
  68.  
  69.   TOleFileHeader = array[1..4] of Char;
  70.  
  71. { Application client structure }
  72.  
  73.   TAppClient = record
  74.     OleClient: TOleClient;
  75.     ObjectWindow: PObjectWindow;
  76.   end;
  77.  
  78. { Application stream structure }
  79.  
  80.   TAppStream = record
  81.     OleStream: TOleStream;
  82.     OwlStream: PStream;
  83.   end;
  84.  
  85. { OLE object window }
  86.  
  87.   TObjectWindow = object(TWindow)
  88.     AppClient: TAppClient;
  89.     OleObject: POleObject;
  90.     Framed: Boolean;
  91.     constructor Init(Link: Boolean);
  92.     constructor Load(var S: TStream);
  93.     destructor Done; virtual;
  94.     function GetClassName: PChar; virtual;
  95.     procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  96.     procedure SetupWindow; virtual;
  97.     procedure Store(var S: TStream); virtual;
  98.     function CanClose: Boolean; virtual;
  99.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  100.     procedure GetObjectClass(ClassName: PChar);
  101.     procedure Check(OleStatus: TOleStatus);
  102.     procedure OpenObject(Verb: Word);
  103.     procedure CloseObject;
  104.     procedure CopyToClipboard;
  105.     procedure Delete;
  106.     procedure Update;
  107.     procedure BringToFront;
  108.     procedure GetBounds(var R: TRect);
  109.     procedure SetBounds(var R: TRect);
  110.     procedure ShowFrame(EnableFrame: Boolean);
  111.     procedure WMGetMinMaxInfo(var Msg: TMessage);
  112.       virtual wm_First + wm_GetMinMaxInfo;
  113.     procedure WMMove(var Msg: TMessage);
  114.       virtual wm_First + wm_Move;
  115.     procedure WMSize(var Msg: TMessage);
  116.       virtual wm_First + wm_Size;
  117.     procedure WMLButtonDown(var Msg: TMessage);
  118.       virtual wm_First + wm_LButtonDown;
  119.     procedure WMMouseMove(var Msg: TMessage);
  120.       virtual wm_First + wm_MouseMove;
  121.     procedure WMLButtonUp(var Msg: TMessage);
  122.       virtual wm_First + wm_LButtonUp;
  123.     procedure WMLButtonDblClk(var Msg: TMessage);
  124.       virtual wm_First + wm_LButtonDblClk;
  125.   end;
  126.  
  127. { Application main window }
  128.  
  129.   TMainWindow = object(TWindow)
  130.     ObjectWindow: PObjectWindow;
  131.     ClientDoc: LHClientDoc;
  132.     Modified: Boolean;
  133.     Filename: TFilename;
  134.     constructor Init;
  135.     destructor Done; virtual;
  136.     function CanClose: Boolean; virtual;
  137.     procedure InitDocument;
  138.     procedure DoneDocument;
  139.     procedure SetFilename(Name: PChar);
  140.     function NewFile(Name: PChar): Boolean;
  141.     function LoadFile: Boolean;
  142.     function SaveFile: Boolean;
  143.     function Save: Boolean;
  144.     function SaveAs: Boolean;
  145.     procedure NewObjectWindow(Link: Boolean);
  146.     procedure SelectWindow(Window: PObjectWindow);
  147.     procedure UpdateObjectMenu;
  148.     procedure WMLButtonDown(var Msg: TMessage);
  149.       virtual wm_First + wm_LButtonDown;
  150.     procedure WMInitMenu(var Msg: TMessage);
  151.       virtual wm_First + wm_InitMenu;
  152.     procedure CMFileNew(var Msg: TMessage);
  153.       virtual cm_First + cm_FileNew;
  154.     procedure CMFileOpen(var Msg: TMessage);
  155.       virtual cm_First + cm_FileOpen;
  156.     procedure CMFileSave(var Msg: TMessage);
  157.       virtual cm_First + cm_FileSave;
  158.     procedure CMFileSaveAs(var Msg: TMessage);
  159.       virtual cm_First + cm_FileSaveAs;
  160.     procedure CMFileExit(var Msg: TMessage);
  161.       virtual cm_First + cm_FileExit;
  162.     procedure CMEditCut(var Msg: TMessage);
  163.       virtual cm_First + cm_EditCut;
  164.     procedure CMEditCopy(var Msg: TMessage);
  165.       virtual cm_First + cm_EditCopy;
  166.     procedure CMEditPaste(var Msg: TMessage);
  167.       virtual cm_First + cm_EditPaste;
  168.     procedure CMEditPasteLink(var Msg: TMessage);
  169.       virtual cm_First + cm_EditPasteLink;
  170.     procedure CMEditClear(var Msg: TMessage);
  171.       virtual cm_First + cm_EditClear;
  172.     procedure CMHelpAbout(var Msg: TMessage);
  173.       virtual cm_First + cm_HelpAbout;
  174.     procedure DefCommandProc(var Msg: TMessage); virtual;
  175.   end;
  176.  
  177. { Application object }
  178.  
  179.   TApp = object(TApplication)
  180.     constructor Init(AName: PChar);
  181.     destructor Done; virtual;
  182.     procedure InitMainWindow; virtual;
  183.   end;
  184.  
  185. { Initialized globals }
  186.  
  187. const
  188.   Dragging: Boolean = False;
  189.   OleFileHeader: TOleFileHeader = 'TPOF';
  190.   OleProtocol: PChar = 'StdFileEditing';
  191.   OleObjectName: PChar = 'Object';
  192.   OleDemoTitle: PChar = 'OLE Demo';
  193.  
  194. { Global variables }
  195.  
  196. var
  197.   App: TApp;
  198.   DragPoint: TPoint;
  199.   MainWindow: PMainWindow;
  200.   OleClientVTbl: TOleClientVTbl;
  201.   OleStreamVTbl: TOleStreamVTbl;
  202.   PixPerInch: TPoint;
  203.   CFObjectLink, CFOwnerLink: Word;
  204.  
  205. { TObjectWindow stream registration record }
  206.  
  207. const
  208.   RObjectWindow: TStreamRec = (
  209.     ObjType: 999;
  210.     VmtLink: Ofs(TypeOf(TObjectWindow)^);
  211.     Load: @TObjectWindow.Load;
  212.     Store: @TObjectWindow.Store);
  213.  
  214. { Display an error message using the MessageBox API routine. }
  215.  
  216. procedure Error(Message, Argument: PChar);
  217. var
  218.   S: array[0..255] of Char;
  219. begin
  220.   wvsprintf(S, Message, Argument);
  221.   MessageBox(0, S, OleDemoTitle, mb_IconExclamation + mb_Ok);
  222. end;
  223.  
  224. { Display OLE operation error message. }
  225.  
  226. procedure OleError(Status: Word);
  227. var
  228.   S: array[0..7] of Char;
  229. begin
  230.   wvsprintf(S, '%d', Status);
  231.   Error('Warning: OLE operation failed, error code = %s.', S);
  232. end;
  233.  
  234. { Display an Open or Save As file dialog using the Common Dialog DLL. }
  235.  
  236. function FileDialog(Owner: HWnd; Filename: PChar; Save: Boolean): Boolean;
  237. const
  238.   DefOpenFilename: TOpenFilename = (
  239.     lStructSize: SizeOf(TOpenFilename);
  240.     hwndOwner: 0;
  241.     hInstance: 0;
  242.     lpstrFilter: 'OLE files (*.OLE)'#0'*.ole'#0;
  243.     lpstrCustomFilter: nil;
  244.     nMaxCustFilter: 0;
  245.     nFilterIndex: 0;
  246.     lpstrFile: nil;
  247.     nMaxFile: SizeOf(TFilename);
  248.     lpstrFileTitle: nil;
  249.     nMaxFileTitle: 0;
  250.     lpstrInitialDir: nil;
  251.     lpstrTitle: nil;
  252.     Flags: 0;
  253.     nFileOffset: 0;
  254.     nFileExtension: 0;
  255.     lpstrDefExt: 'ole');
  256. var
  257.   OpenFilename: TOpenFilename;
  258. begin
  259.   OpenFilename := DefOpenFilename;
  260.   OpenFilename.hwndOwner := Owner;
  261.   OpenFilename.lpstrFile := Filename;
  262.   if Save then
  263.   begin
  264.     OpenFilename.Flags := ofn_PathMustExist + ofn_NoChangeDir +
  265.       ofn_OverwritePrompt;
  266.     FileDialog := GetSaveFilename(OpenFilename);
  267.   end else
  268.   begin
  269.     OpenFileName.Flags := ofn_PathMustExist;
  270.     FileDialog := GetOpenFilename(OpenFilename);
  271.   end;
  272. end;
  273.  
  274. { OLE client callback routine. Called by the OLE client library to notify
  275.   the application of any changes to an object. I